Assassins - Ultimate CD Games Collection 2/Assassins 2 - Ultimate Games No. 2 (1995)(Weird Science)[!][Amiga-CD32-CDTV].iso/puzzles/picture_it/source/picture-it.amos/picture-it.amosSourceCode

AMOS Source Code | 1995-01-01 | 11KB | 504 lines

Dim X(40),Y(40)
Dim A$(10)
Dim T$(10),PNT$(10)
A$(1)="Loop:Move RX-12,RY-6,10; Move RX+12,RY+6,20;P; Jump Loop"
A$(2)="Loop:Move RX-20,RY-32,14; Move RX+20,RY+32,20;P; Jump Loop"
A$(3)="Loop:Move RX+40,RY-3,40; Move RX-40,RY+3,20;P; Jump Loop"
A$(4)="Loop:Move RX-25,RY+70,14; Move RX+25,RY-70,50;P;P; Jump Loop"
A$(5)="Loop:Move RX-112,RY-3,10; Move RX+112,RY+3,20;P; Jump Loop"
A$(6)="Loop:Move RX+120,RY-52,114; Move RX-120,RY+52,80;P;P; Jump Loop"
A$(7)="Loop:Move RX-180,RY-132,140; Move RX+180,RY+132,65;P; Jump Loop"
A$(8)="Loop:Move RX+28,RY+102,49; Move RX-28,RY-102,22;P;P; Jump Loop"
A$(9)="Loop:Move RX-20,RY+92,55; Move RX+20,RY-92,20;P; Jump Loop"
A$(10)="Loop:Move RX,RY-100,100; Move RX,RY+100,20;P; Jump Loop"
'
M$="Loop:Let X=XM-135;Let Y=YM-50;P;Jump Loop"
'
Load ":sounds/PSamp.Abk"
Load ":music/pi-music.abk"
Screen Open 0,320,200,16,Lowres
Global T,ALLWD,WEIGHT,PARTS,SCORE,TRY,DEAD,W,H,AM,DFLAG,LC,GOT1
DFLAG=1 : LC=1
Music 1
Do
   DEAD=False
   Proc TITLE
   Proc HIGHTABLE[SCORE,PLYR$]
   Load Iff "Pictures:scb",1
   Screen Display 1,,250,320,42
   Screen 1 : Flash Off : Curs Off
   Set Rainbow 0,0,62,"(1,1,12)","","(1,-4,15)"
   Rainbow 0,1,251,62
   Screen To Front 1
   LVL=1 : SCORE=0 : TEMSCORE=0
   Proc PLVL[LVL]
   Proc SETUP[LVL]
   Repeat
      K$=Inkey$
      Inc D
      If D>=10.0
         Proc CLOCK : D=0
      End If
      M=Mouse Key
      If GOT1=False
         If Bob Col(AM+1) and M=%1
            Sam Play 1
            For C=1.0 To AM
               If Col(C)
                  Amal Off C : CURRENT=C
                  Proc PPIECE[CURRENT]
                  GOT1=True
               End If
            Next C
         End If
      End If
      If GOT1
         Bob CURRENT,X Bob(AM+1)-15,Y Bob(AM+1)-15,
         If M=%10
            If X Bob(CURRENT)<=X(CURRENT-1)+10 and X Bob(CURRENT)>=X(CURRENT-1)-10 and Y Bob(CURRENT)>=Y(CURRENT-1)-10 and Y Bob(CURRENT)<=Y(CURRENT-1)+10
               Paste Bob X(CURRENT-1),Y(CURRENT-1),CURRENT : Sam Play 2
               Amal Off CURRENT : Bob Off CURRENT : GOT1=False : Inc PLACED
               Add SCORE,5 : Add TEMSCORE,5 : Proc PSCORE : Proc PPIECE[0]
            Else
               Amal CURRENT,A$(Rnd(9)+1) : Amal On CURRENT
               Proc PPIECE[0] : GOT1=False : Sam Play 3
            End If
         End If
      End If
      If T>=ALLWD
         Proc TLATE
      End If
      If K$="q"
         Goto QUIT
      End If
      Synchro
      If PLACED=AM
         Bell 30 : Wait 15 : Bell 50 : Wait 17 : Bell 45
         Inc LVL : TRY=0 : Inc LC
         For F=0 To 6
            Ink F+1
            Box F,F To 319-F,198-F
         Next
         Wait 80
         If LVL=5
            Sam Play 5
         End If
         If LC>30
            Randomize Timer
            LVL=Rnd(29)+1
         End If
         If PARTS
            SCORE=SCORE+(ALLWD mod T)-(WEIGHT/2)
            Proc PSCORE
         Else
            SCORE=SCORE+(ALLWD mod T+20)
            Proc PSCORE
         End If
         Proc NLWIND
      End If
      Wait Vbl
   Until DEAD
   QUIT:
   LVL=1 : TRY=0
   Screen 1
   Rainbow Del
   Screen Close 1
   Screen 0
   Gr Writing 0
   Bob Off : Amal Off : Synchro On
   Cls 0
   Proc FINISH_BOW
   Text 138,97,"GAME OVER"
   Wait 20
   Proc HIGHTABLE[SCORE,PLYR$]
   Rainbow Del 2
   Wait 50
Loop
'
Procedure SETUP[N]
   Shared A$(),M$,PLACED,TEMSCORE
   PLACED=0 : T=0 : TEMSCORE=0
   Load Iff "Pictures:pic"+Mid$(Str$(N),2),0
   If N<=4
      AM=20 : W=64 : H=50 : HW=256 : VH=150
      If DFLAG=1
         Proc BIG_DAT
      End If
   Else
      AM=40 : W=40 : H=40 : HW=280 : VH=160
      If DFLAG=2
         Proc SMALL_DAT
      End If
   End If
   Erase 1
   Screen 0
   Synchro Off : Flash Off : Hide On
   A=0.0 : I=1.0
   Volume %1111,40
   Repeat
      B=0.0
      Repeat
         Get Bob 0,I,B,A To B+W,A+H
         Add B,W : Inc I
      Until B>HW
      Add A,H
   Until A>VH
   Wait 130
   Cls 0
   Circle 7,7,5
   Ink 5
   Circle 7,7,3
   Ink 1
   Circle 7,7,2
   Get Bob ,AM+1,0,0 To 16,16
   Cls 0
   GOT1=False
   Double Buffer
   Make Mask
   For M=1.0 To AM
      Bob M,320,200,M
      Channel M To Bob M
   Next
   Bob AM+1,320,256,AM+1
   Channel AM+1 To Bob AM+1
   Amal AM+1,M$
   Randomize Timer
   For M=1.0 To AM
      Set Bob M,1,,
      Hot Spot M,0,0
      Amal M,A$(Rnd(9)+1.0)
      Bob M,Rnd(240)+20.0,Rnd(120)+10.0,M
   Next
   Amal On
   Screen To Front 1
   Screen 1
   Ink 7
   Bar 41.0,9.0 To 63.0,17.0
   Screen 0
End Proc
Procedure PSCORE
   Screen 1
   Ink 1,7
   S$=Mid$(Str$(SCORE),2)
   Text 91.0,34.0,S$
   Screen 0
End Proc
Procedure CLOCK
   Screen 1
   Inc T
   Ink 1,7,
   T$=Mid$(Str$(T),2)
   Text 41.0,16.0,T$
   Screen 0
End Proc
Procedure PLVL[N]
   Screen 1
   Ink 1,7,
   L$=Mid$(Str$(N),2)
   Text 113.0,16.0,L$
   If N=1 or N=2 Then ALLWD=90
   If N=3 or N=4 Then ALLWD=85
   If N=18 Then ALLWD=170
   If N=23 or N=25 Then ALLWD=185
   If N=10 or N=11 or N=20 or N=21 or N=22 or N=27 Then ALLWD=220
   If N=5 or N=7 or N=9 or N=14 or N=15 or N=26 Then ALLWD=240
   If N=13 or N=17 or N=19 or N=24 or N=28 Then ALLWD=270
   If N=16 or N=12 or N=29 Then ALLWD=326
   If N=6 or N=8 Then ALLWD=352
   ALLWD=ALLWD+WEIGHT
   Ink 7
   Bar 252,28 To 275,37
   Ink 1,7
   AL$=Mid$(Str$(ALLWD),2)
   Text 252.0,34.0,AL$
   Screen 0
End Proc
Procedure TLATE
   Shared LVL,TEMSCORE
   Screen 0
   Sam Play 4
   Amal Off : Bob Off
   GOT1=False
   Gr Writing 0
   For I=1.0 To 70.0
      Ink Rnd(15),Rnd(15)-1.0
      Text Rnd(270)+5.0,Rnd(185),"Too Slow"
   Next
   Wait 100
   Cls 0
   Screen 1
   Add TRY,1
   Ink 7
   Bar 91.0,26.0 To 120.0,34.0
   SCORE=SCORE-TEMSCORE
   S$=Mid$(Str$(SCORE),2)
   Text 91,34,S$
   If TRY=3
      Screen 0
      Cls 0
      If LVL>=3
         Proc FINISH_BOW
         Gr Writing 0
         Text 115,97,"Go Back Two Levels"
         SCORE=SCORE-100
         Wait 100
         Rainbow Del 2
         LVL=LVL-2 : LC=LC-2
         Proc PLVL[LVL] : Proc SETUP[LVL]
      End If
   End If
   If TRY>3
      DEAD=True : Pop Proc
   Else
      Proc PLVL[LVL] : SETUP[LVL]
   End If
End Proc
Procedure NLWIND
   Shared LVL
   Screen 1
   Ink 1
   Text 202,15,"Press Any Key"
   Repeat
      K$=Inkey$
      If K$<>""
         Ink 7 : Bar 200,8 To 304,17
         Proc PLVL[LVL] : SETUP[LVL]
      End If
   Until K$<>""
End Proc
Procedure PPIECE[N]
   If Not PARTS Then Pop Proc
   Screen 1
   If N<=0
      Ink 7
      Bar 177,9 To 192,17
   Else
      CU$=Mid$(Str$(N),2)
      Text 177,16,CU$
   End If
   Screen 0
End Proc
Procedure TITLE
   Shared PLYR$
   SCORE=0
   Auto View Off
   Load Iff "Pictures:pickit.t",0
   Double Buffer
   Flash Off : Hide On
   Set Rainbow 1,0,160,"(8,1,2)","(2,1,1)","(7,1,2)"
   Rainbow 1,1,45,256
   Channel 0 To Rainbow 1
   Amal 0,"Loop: For RA=0 To 160; Let X=RA; P; Next RA; P;Jump Loop"
   Screen Display 0,140,50,,
   I=1 : A=0
   Repeat
      B=0.0
      Repeat
         Get Bob 0,I,B,A To B+160,A+100
         Add B,160 : Inc I
      Until B>180
      Add A,100
   Until A>150
   Channel 1 To Bob 1
   Channel 2 To Bob 2
   Channel 3 To Bob 3
   Channel 4 To Bob 4
   Cls 0
   View
   Auto View On
   Amal On 0
   Bob 1,0,0,1
   Bob 2,160,0,2
   Bob 3,0,100,3
   Bob 4,160,100,4
   Amal 1,"Loop: Move -100,-100,150; "
   Amal 2,"Loop: Move 100,-100,150; "
   Amal 3,"Loop: Move -100,100,150; "
   Amal 4,"Loop: Move 100,100,150; "
   Repeat
   Until Mouse Key
   Ink 31,0
   Set Pattern 8
   Bar 1,1 To 319,198
   Amal Freeze 0
   For I=1 To 4
   Amal On I
   Next
  Repeat
  Until Not Chanmv(4)
      For I=1 To 4
       Amal Off I
        Next
        Amal On 0
 Wait 50
 Erase 1
   Screen Open 1,300,30,4,Lowres
   Screen Display 1,150,100,300,30
   Curs Off
   Cls 0
   Locate 0,1
   Centre Border$("Enter Your Name .......... ",2)
   Locate 19,1
   Input ":";PLYR$
   Cls 0
   Curs Off
   Locate 0,1
   Centre Border$("Beginer or Ace b/a ",2)
   Repeat
      K$=Inkey$
   Until K$<>""
   If K$="b"
      PARTS=True : WEIGHT=30
   Else
      PARTS=False : WEIGHT=0
   End If
   Cls 0
   Locate 0,1
   Centre Border$("Music On y/n ",2)
   Repeat
      K$=Inkey$
   Until K$<>""
   If K$="n"
      Screen Close 1
      M=60
      Repeat
         Mvolume M
         Dec M
         Wait 2
      Until M=0
      Music Stop
   Else
      Screen Close 1
      Mvolume 40
      Music 1
   End If
   Screen 0
   Ink 0
         For F=0 To 100
            Box F,F To 319-F,198-F
         Next
   Amal Off
   Rainbow Del 1
End Proc
Procedure SMALL_DAT
   Shared X(),Y()
   For D=0 To 39
      Read A : X(D)=A
   Next
   Data 0,40,80,120,160,200,240,280
   Data 0,40,80,120,160,200,240,280
   Data 0,40,80,120,160,200,240,280
   Data 0,40,80,120,160,200,240,280
   Data 0,40,80,120,160,200,240,280
   '
   For D=0 To 39
      Read B : Y(D)=B
   Next
   '
   Data 0,0,0,0,0,0,0,0,40,40
   Data 40,40,40,40,40,40,80,80,80,80
   Data 80,80,80,80,120,120,120,120,120,120
   Data 120,120,160,160,160,160,160,160,160,160
   Restore
   DFLAG=1
End Proc
Procedure BIG_DAT
   Shared X(),Y()
   For D=0 To 19
      Read A : X(D)=A
   Next
   Data 0,64,128,192,256
   Data 0,64,128,192,256
   Data 0,64,128,192,256
   Data 0,64,128,192,256
   '
   For D=0 To 19
      Read B : Y(D)=B
   Next
   Data 0,0,0,0,0
   Data 50,50,50,50,50
   Data 100,100,100,100,100
   Data 150,150,150,150,150
   Restore
   DFLAG=2
End Proc
Procedure FINISH_BOW
   Set Rainbow 2,0,190,"","",""
   Rainbow 2,0,50,190
   Wave 0 To 15
   TEMP1=1 : TEMP2=1
   For P=89 To 0 Step -1
      Rain(2,P)=TEMP2*20
      Rain(2,189-P)=TEMP2*20
      Play 0+(16+(P/2)),0
      View
      Add TEMP1,1,1 To 8
      If TEMP1=8 Then Inc TEMP2
   Next
End Proc
Procedure HIGHTABLE[SCR,PLYR$]
   Shared T$(),PNT$(),PLYR$
   Auto View Off
   Curs Off
   Screen Open 3,320,256,8,Lowres
   Load Iff "Pictures:sctable",3
   Screen To Front 3
   Screen 3
   Set Rainbow 2,1,256,"(1,1,2)","(2,1,1)","(3,1,2)"
   Rainbow 2,1,40,256
   Channel 0 To Rainbow 2
   Amal 0,"Loop: For RA=0 To 256; Let Y=RA;Let X=RA*2; P; Next RA;P; Jump Loop"
   '
   Open Random 1,"Pictures:HIGHSCORE"
   Field 1,10 As HIGHNAME$,7 As SCR$
   '
   For I=1 To 10
      Get 1,I
      T$(I-1)=HIGHNAME$ : PNT$(I-1)=SCR$
   Next
   '
   TEMP$=Str$(SCR)
   For A=1 To 10
      V1=Val(TEMP$) : V2=Val(PNT$(A-1))
      If V1>V2
         PNT$(10)=TEMP$
         T$(10)=PLYR$
         Put 1,9
         Exit
      End If
   Next
   '
   For A=0 To 9
      For B=A+1 To 10
         If Val(PNT$(B))>Val(PNT$(A))
            Swap T$(A),T$(B) : Swap PNT$(A),PNT$(B)
         End If
      Next
   Next
   '
   For I=1 To 10
      HIGHNAME$=T$(I-1)
      SCR$=PNT$(I-1)
      Put 1,I
   Next
   '
   Ink 1
   Gr Writing 0
   For I=1 To 10
      Get 1,I
      Text 95,74+14*I,HIGHNAME$ : Text 175,74+14*I,SCR$
   Next
   Close 1
   View
   Auto View On
   Amal On 0
   Repeat
   Until Mouse Key
   Ink 0
         For F=0 To 125
         Play 1,F/2,0
            Box F,F To 319-F,255-F
         Next
   Rainbow Del 2 : Amal Off 0
   Screen Close 3
End Proc